home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 1
/
Precision Software Applications Silver Collection Volume One (PSM) (1993).iso
/
tutor
/
ada1tutr.arj
/
VANILLA.ADA
< prev
next >
Wrap
Text File
|
1992-09-04
|
3KB
|
51 lines
-- VANILLA.ADA Ver. 2.02 4-SEP-1992 Copyright 1988-1992 John J. Herro
-- Software Innovations Technology
-- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706 (407)951-0233
--
-- "Plain vanilla" version of CUSTOM_IO which should work with ANY standard Ada
-- compiler. Compile this before compiling ADA_TUTR.ADA.
--
with TEXT_IO;
package CUSTOM_IO is
type COLOR is (BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE);
FOREGRND_COLOR : COLOR := WHITE; -- Default values in case
BACKGRND_COLOR : COLOR := BLACK; -- ADA-TUTR finds no User
BORDER_COLOR : COLOR := BLACK; -- File.
FORE_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(FOREGRND_COLOR)+48);
BACK_COLOR_DIGIT : CHARACTER := CHARACTER'VAL(COLOR'POS(BACKGRND_COLOR)+48);
NORMAL_COLORS : STRING(1 .. 10) := ASCII.ESC & "[0;3" &
FORE_COLOR_DIGIT & ";4" & BACK_COLOR_DIGIT & "m";
CLEAR_SCRN : constant STRING := ASCII.ESC & "[H" & ASCII.ESC & "[2J";
procedure SET_BORDER_COLOR (TO : in COLOR);
procedure GET (CHAR : out CHARACTER) renames TEXT_IO.GET;
procedure PUT (CHAR : in CHARACTER) renames TEXT_IO.PUT;
procedure PUT (STR : in STRING) renames TEXT_IO.PUT;
procedure PUT_LINE (STR : in STRING) renames TEXT_IO.PUT_LINE;
procedure GET_LINE (STR : out STRING;
LAST : out NATURAL) renames TEXT_IO.GET_LINE;
procedure NEW_LINE (SPACING : in TEXT_IO.COUNT := 1)
renames TEXT_IO.NEW_LINE;
end CUSTOM_IO;
package body CUSTOM_IO is
procedure SET_BORDER_COLOR(TO : in COLOR) is
--
-- This is a dummy procedure. If your PC Ada compiler allows interrupt
-- calls or assembly language, you may want to write code to call
-- interrupt 10 hex. (See JANUS.ADA and MERIDIAN.ADA for examples.)
-- Before the call, set register AH to service number 0B hex, set BH to
-- zero, and set BL to COLOR_NUMBER(TO), where COLOR_NUMBER is declared
-- below. Note that the integers in COLOR_NUMBER are bit reversed from
-- the integers defining foreground and background colors in ANSI escape
-- sequences. Note also that some color PCs don't have separate border
-- colors.
--
COLOR_NUMBER : constant array(COLOR) of INTEGER :=
(BLACK => 0, RED => 4, GREEN => 2, YELLOW => 6,
BLUE => 1, MAGENTA => 5, CYAN => 3, WHITE => 7);
begin
null;
end SET_BORDER_COLOR;
end CUSTOM_IO;